home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / ada / adaed-1.11 / adaed-1 / Adaed-1.11.0a / sep.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-02-07  |  5.0 KB  |  164 lines
  1. /*
  2.  * Copyright (C) 1985-1992  New York University
  3.  * 
  4.  * This file is part of the Ada/Ed-C system.  See the Ada/Ed README file for
  5.  * warranty (none) and distribution info and also the GNU General Public
  6.  * License for more details.
  7.  
  8.  */
  9.  
  10. #define GEN
  11.  
  12. #include "hdr.h"
  13. #include "ifile.h"
  14. #include "slot.h"
  15. #include "libhdr.h"
  16. #include "vars.h"
  17. #include "gvars.h"
  18. #include "ops.h"
  19. #include "type.h"
  20. #include "segment.h"
  21. #include "setprots.h"
  22. #include "axqrprots.h"
  23. #include "genprots.h"
  24. #include "gutilprots.h"
  25. #include "segmentprots.h"
  26. #include "readprots.h"
  27. #include "gmiscprots.h"
  28. #include "libprots.h"
  29. #include "sepprots.h"
  30.  
  31. extern Segment    CODE_SEGMENT, DATA_SEGMENT, DATA_SEGMENT_MAIN;
  32.  
  33. /* Chapter 10: Separate compilation
  34.  * Stubs
  35.  */
  36.  
  37. void gen_stub(Node stub_node)                                    /*;gen_stub*/
  38. {
  39.     /* This procedure generate the code to elaborate the proper body of the
  40.      * body stub, at the place of the corresponding stub.
  41.      * In any case, a spec corresponding to the stub has been elaborated.
  42.      * A data slot is assigned to the subunit (the code segment has already
  43.      * been assigned by the spec declaration, in the case of a subprogram).
  44.      */
  45.  
  46.     Segment    stemplate;
  47.     int        tag, stub_cs, si;
  48.     char    *u_nam;
  49.     Symbol    name, temp_name, package_proc;
  50.     unsigned int patch_addr;
  51.     struct tt_subprog *tptr;
  52.  
  53. #ifdef TRACE
  54.     if (debug_flag)
  55.         gen_trace_node("GEN_STUB", stub_node);
  56. #endif
  57.  
  58.     STUBS_IN_UNIT = TRUE;
  59.  
  60.     u_nam = N_VAL(stub_node);
  61.     read_stub_short(lib_stub_get(u_nam), u_nam, "st1");
  62.     si = stub_numbered(u_nam);
  63.     collect_stub_node_units(si);
  64.  
  65.     tag   = N_KIND(stub_node);
  66.     if (tag == as_subprogram_stub_tr) {
  67.         name     = N_UNQ(stub_node);
  68.     }
  69.     else {
  70.         name     = N_UNQ(stub_node);
  71.         if (NATURE(name) == na_generic_package) return;
  72.     }
  73.     /* In the case where the stub is nested in a package body the current level
  74.      * is set wrong, since it will be incremented after the call to gen_stub
  75.      * and will be off by one in the stub field. However no correct fix is
  76.      * known at this time. (BB  2-27-86)
  77.      */
  78.     current_level_put(u_nam, CURRENT_LEVEL);
  79.  
  80.     lib_stub_put(u_nam, AISFILENAME);
  81.  
  82.     switch (tag) {
  83.  
  84.     case(as_subprogram_stub_tr): 
  85.     case(as_task_stub):
  86.         if (tag == as_task_stub) {
  87.             name = assoc_symbol_get(name, TASK_INIT_PROC);
  88.         }
  89.         stub_cs = select_entry(SELECT_CODE, name, SLOTS_CODE_BORROWED);
  90.  
  91.         if (CURRENT_LEVEL > 1) { /* may need relay set */
  92.             temp_name = (assoc_symbol_exists(name, PROC_TEMPLATE)) ?
  93.               assoc_symbol_get(name, PROC_TEMPLATE) : (Symbol)0;
  94.  
  95.             /* The template is already generated in the case of a subprogram */
  96.             /* declared in the spec of a package whose body is separate */
  97.             if (temp_name ==(Symbol)0 || !is_defined(temp_name)) {
  98.                 temp_name = new_unique_name("proc_template"); /* assoc. name */
  99.                 assoc_symbol_put(name, PROC_TEMPLATE, temp_name);
  100.                 generate_object(temp_name);
  101.                 stemplate = template_new(TT_SUBPROG, -1, WORDS_SUBPROG,
  102.                   (int **)&tptr);
  103.                 tptr->cs =  stub_cs;
  104.                 tptr->relay_slot =  stub_cs; /* relay slot */
  105.                 next_global_reference_template(temp_name, stemplate);
  106.                 segment_free(stemplate);
  107.                 patch_addr = subprog_patch_get(name);
  108.                 subprog_patch_undef(name); /* No more needed */
  109.                 gen(I_END); /* flush peep-hole stack before patching */
  110.                 reference_of(temp_name);
  111.                 segment_set_pos(CODE_SEGMENT, patch_addr, 0);
  112.                 segment_put_ref(CODE_SEGMENT, REFERENCE_SEGMENT,
  113.                   REFERENCE_OFFSET);
  114.                 segment_set_pos(CODE_SEGMENT, 0, 2); /* position at end */
  115.             }
  116.             gen_s(I_PUSH_EFFECTIVE_ADDRESS, temp_name);
  117.             gen_s(I_SUBPROGRAM, name);
  118.         }
  119.         break;
  120.  
  121.     case(as_package_stub):
  122.         /* We must preserve the signature of this package (and of its */
  123.         /* sub-packages) in its stub_environment, as long as the FE doesn't */
  124.         /* generate the signature of packages. The following may preserve */
  125.         /* too much, but it doesn't hurt: */
  126. #ifdef TBSL
  127.         /* ev already retrieved above */
  128.          *
  129.          * STUB_ENV(u_nam)(11) = { [pack, SIGNATURE(pack)]:
  130.          *            nat=NATURE(pack) | nat = na_package_spec        };
  131.          */
  132. #endif
  133.         package_proc = new_unique_name("proc_template"); /* assoc. name */
  134.         temp_name    = new_unique_name("pack_proc_template");
  135.         assoc_symbol_put(name, INIT_BODY, package_proc);
  136.         assoc_symbol_put(package_proc, PROC_TEMPLATE, temp_name);
  137.         generate_object(package_proc);
  138.         generate_object(temp_name);
  139.         stub_cs    = select_entry(SELECT_CODE, package_proc, SLOTS_CODE);
  140.         /*CODE_SEGMENT_MAP(stub_cs) := [];*/
  141.         /* Is this freeing a code seg or allocating a new one ?? ds 6-12-85*/
  142.         CODE_SEGMENT_MAP = segment_map_put(CODE_SEGMENT_MAP,
  143.           stub_cs, segment_new(SEGMENT_KIND_CODE, 0));
  144.         next_local_reference(package_proc);
  145.         stemplate = template_new(TT_SUBPROG, -1, WORDS_SUBPROG,
  146.           (int **)&tptr);
  147.         tptr->cs =  stub_cs;
  148.         tptr->relay_slot =  stub_cs; /* relay slot */
  149.         next_global_reference_template(temp_name, stemplate);
  150.         segment_free(stemplate);
  151.         gen_s(I_PUSH_EFFECTIVE_ADDRESS, temp_name);
  152.         gen(I_CREATE_STRUC);
  153.         gen_s(I_UPDATE_AND_DISCARD, package_proc);
  154.         gen_s(I_PUSH_EFFECTIVE_ADDRESS, temp_name);
  155.         gen_s(I_SUBPROGRAM, package_proc);
  156.         gen_s(I_CALL, package_proc);
  157.  
  158.     default:          /* Stub as the body of a generic unit.... */
  159.         ;
  160.  
  161.     }
  162.     stubs_to_write = set_with(stubs_to_write, (char *) si);
  163. }
  164.